home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1999 January - Disc 2 / Macworld (1999-01) (Disk 2).dmg / Serious Demos / Symbolic Composer 4.2 / Environment / Projects / Contributed Scores / Peter Stone Punctus / Overtones < prev    next >
Lisp/Scheme  |  1998-10-26  |  3KB  |  78 lines
  1. (setq p1 '(a b c d e  f g h i j   k l m n o   p q r s t))
  2. (setq p2 (gen-random 0.5 20 '(a b c d e  f g h i j)))
  3. (setq p3 (gen-random 0.51 20 '(a b c d e  f g h i j)))
  4. (setq p4 '(a b c d e  f g h i j   k l m n o   p q r s t))
  5.  
  6. (defun pick-nth (start step l)
  7.   (let (out)
  8.     (for i start step (length l) nil
  9.       (if (nth i l) (push (nth i l) out)))
  10.     (nreverse out)))
  11.  
  12. (setq p1 '(a b c d e  f g h i j   k l m n o   p q r s t))
  13. (setq p2 (append (pick-nth 0 2 p1) (pick-nth 1 2 p1)))
  14. (setq p3 (append (pick-nth 0 2 p2) (pick-nth 1 2 p2)))
  15. (setq p4 '(a b c d e  f g h i j   k l m n o   p q r s t))
  16.  
  17. (setq p1 '(a b c d e  f g h i j   k l m n o   p q r s t))
  18. (setq p2 (gen-random 0.5 20 '(a b c d e  f g h i j)))
  19. (setq p3 (reverse p1))
  20. (setq p4 (reverse p2))
  21.  
  22. (setq p1-p2 (symbol-interpolate 8 p1 p2))
  23. (setq p2-p3 (symbol-interpolate 8 p2 p3))
  24. (setq p3-p4 (symbol-interpolate 8 p3 p4))
  25.  
  26. (setq melody (flatten (symbol-repeat 2 (append p1-p2 (cdr p2-p3) (cdr p3-p4)))))
  27.  
  28. (create-tonality test '(1/1 2/1 3/1 4/1 5/1 6/1 7/1 8/1 9/1 10/1 11/1 12/1 13/1 14/1 15/1 16/1 17/1 18/1 19/1 20/1))
  29. (create-tonality test2 '(1/1 3/1 5/1 7/1 9/1 11/1 13/1 15/1 17/1 19/1 
  30.                         21/1 23/1 25/1 27/1 29/1 31/1 33/1 35/1 37/1))
  31.  
  32. ;; panning
  33.  
  34. (setq freq 9) (setq samples 1024)
  35. (setq modulator (vector-mix (gen-ramp 0.4 0.1 samples)
  36.                             (gen-sin 50 0.01 samples)))
  37.  
  38. (setq pan1
  39.       (vector-modulate (gen-sin freq 0.5 samples)
  40.                        modulator))
  41. (setq pan2
  42.       (vector-modulate (gen-sin freq 0.5 samples 90)
  43.                        modulator))
  44.  
  45. (setq zonelen (* (get-tick '1/16) (length melody)))
  46.  
  47. ; note: realisation depends on the tuning resolution of the synth that
  48. ; you play the piece, change the tuning resolution accordingly
  49.  
  50. (def-section sect-a
  51.   default
  52.      zone (list (/ zonelen 2) (/ zonelen 2))
  53.      motive (def-motive theme
  54.                length '(1/16)
  55.                symbol melody
  56.                velocity (vector-to-list (vector-round 60 90 (gen-sin 3 1 32))))
  57.   piano1 
  58.      channel 1
  59.      tonality (activate-tonality (test c 4 4024) (test2 c 3 4024))
  60.      motive theme
  61.      controller (mu80-controllers
  62.                   panning (list (vector-to-list (vector-round 1 126 pan1))))
  63.   piano2 
  64.      channel 2
  65.      tonality (activate-tonality (test c 4 4024) (test2 c 3 4024))
  66.      motive (rev theme)
  67.      controller (mu80-controllers
  68.                   panning (list (vector-to-list (vector-round 30 100 pan2))))
  69. )
  70.  
  71. (def-tempo 80)
  72.  
  73. (play-file-p nil
  74.    piano1 '(sect-a)
  75.    piano2 '(sect-a)
  76. )
  77.  
  78.